home *** CD-ROM | disk | FTP | other *** search
/ PC Answers 1995 May / PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso / vbits / code / cert / trk3_eg / vbx / global.bas < prev    next >
Encoding:
BASIC Source File  |  1994-01-26  |  5.3 KB  |  169 lines
  1. Option Explicit
  2. 'GetPrivateProfileString
  3. Declare Function GetPrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Integer, ByVal lpFileName As String) As Integer
  4. 'WriteProfileString
  5. Declare Function WritePrivateProfileString Lib "Kernel" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpString As String, ByVal lplFileName As String) As Integer
  6.  
  7. Declare Function GetWindowsDirectory% Lib "Kernel" (ByVal f$, ByVal fLen%)
  8.  
  9. Global WinDir As String
  10. Global avbdir As String
  11. Global dftdir As String
  12. Global tempAVB As String
  13. Global filelinecount As Integer
  14. Global thelist As listbox
  15. Global curmodfile As String
  16. Global AVBfile As String
  17. Global listchange As Integer
  18. Global GetDefaultDir As String
  19. Global GetCurAvb As String
  20.  
  21.  
  22. Type vbxType
  23.     linedata As String
  24.     flagvbxdata As Integer
  25. End Type
  26.  
  27. Global vbxfiledata(1 To 50) As vbxType
  28.  
  29. ' MsgBox parameters
  30. Global Const MB_OK = 0                 ' OK button only
  31. Global Const MB_OKCANCEL = 1           ' OK and Cancel buttons
  32. Global Const MB_ABORTRETRYIGNORE = 2   ' Abort, Retry, and Ignore buttons
  33. Global Const MB_YESNOCANCEL = 3        ' Yes, No, and Cancel buttons
  34. Global Const MB_YESNO = 4              ' Yes and No buttons
  35. Global Const MB_RETRYCANCEL = 5        ' Retry and Cancel buttons
  36.  
  37. Global Const MB_ICONSTOP = 16          ' Critical message
  38. Global Const MB_ICONQUESTION = 32      ' Warning query
  39. Global Const MB_ICONEXCLAMATION = 48   ' Warning message
  40. Global Const MB_ICONINFORMATION = 64   ' Information message
  41.  
  42. Global Const MB_APPLMODAL = 0          ' Application Modal Message Box
  43. Global Const MB_DEFBUTTON1 = 0         ' First button is default
  44. Global Const MB_DEFBUTTON2 = 256       ' Second button is default
  45. Global Const MB_DEFBUTTON3 = 512       ' Third button is default
  46. Global Const MB_SYSTEMMODAL = 4096      'System Modal
  47.  
  48. ' MsgBox return values
  49. Global Const IDOK = 1                  ' OK button pressed
  50. Global Const IDCANCEL = 2              ' Cancel button pressed
  51. Global Const IDABORT = 3               ' Abort button pressed
  52. Global Const IDRETRY = 4               ' Retry button pressed
  53. Global Const IDIGNORE = 5              ' Ignore button pressed
  54. Global Const IDYES = 6                 ' Yes button pressed
  55. Global Const IDNO = 7                  ' No button pressed
  56.  
  57. Function convpath (path As String) As String
  58.  
  59. If Not Right$(path, 1) = "\" Then
  60.     convpath = path & "\"
  61. Else
  62.     convpath = path
  63. End If
  64.  
  65. End Function
  66.  
  67. Sub Fillfile (fillfilename As String)
  68. Dim fhandle As Integer
  69. Dim cnt As Integer
  70.  
  71. fhandle = FreeFile
  72. Open fillfilename For Output As fhandle
  73.  
  74. For cnt = 0 To frmmain.lstVBX.ListCount - 1
  75.     Print #fhandle, frmmain.lstVBX.List(cnt)
  76. Next cnt
  77.  
  78. Close fhandle
  79.  
  80.  
  81. End Sub
  82.  
  83. Function filllist (Fileavbx As String, fileavbxpath As String) As Integer
  84. Dim fhandle As Integer
  85. Dim fname As String
  86. Dim fpath As String
  87. Dim Filedata As String
  88. Dim testvbx As String
  89. Dim firstchar As String
  90. Dim flagvbx As Integer
  91. Dim endflag As Integer
  92. Dim endfiledata As String
  93. Dim endflagfirst As Integer
  94.  
  95. thelist.Clear
  96. If Right$(fileavbxpath, 1) = "\" Then
  97.     fname = fileavbxpath & Fileavbx
  98. Else
  99.     fname = fileavbxpath & "\" & Fileavbx
  100. End If
  101. fhandle = FreeFile
  102. Open fname For Input As fhandle
  103. filelinecount = 0
  104. Do While Not EOF(fhandle)
  105.     filelinecount = filelinecount + 1
  106.     Input #fhandle, Filedata
  107.     testvbx = Right$(Filedata, 3)
  108.     firstchar = Left$(Filedata, 1)
  109.     If testvbx = "VBX" And Not firstchar = "'" Then
  110.         thelist.AddItem Filedata
  111.         flagvbx = True
  112.     Else
  113.         flagvbx = False
  114.     End If
  115.     If Left$(Filedata, 12) = "ProjWinSize=" Then
  116.         endflag = True
  117.     End If
  118.     If endflag Then
  119.         If Not Left$(Filedata, 12) = "ProjWinShow=" Then
  120.             If endflagfirst Then
  121.                 endfiledata = endfiledata & "," & Filedata
  122.             Else
  123.                 endflagfirst = True
  124.                 endfiledata = Filedata
  125.             End If
  126.             filelinecount = filelinecount - 1
  127.         Else
  128.             vbxfiledata(filelinecount).linedata = endfiledata
  129.             vbxfiledata(filelinecount).flagvbxdata = False
  130.             filelinecount = filelinecount + 1
  131.             vbxfiledata(filelinecount).linedata = Filedata
  132.             vbxfiledata(filelinecount).flagvbxdata = False
  133.         End If
  134.      Else
  135.         vbxfiledata(filelinecount).linedata = Filedata
  136.         vbxfiledata(filelinecount).flagvbxdata = flagvbx
  137.      End If
  138. Loop
  139. Close fhandle
  140.  
  141. End Function
  142.  
  143. Function FindWinDir () As String
  144.     Dim stlen As Integer
  145.     Dim filepath As String
  146.     filepath = String$(255, 0)
  147.     stlen = GetWindowsDirectory(filepath, Len(filepath))
  148.     filepath = Left$(filepath, stlen) + "\"
  149.     FindWinDir = filepath
  150. End Function
  151.  
  152. Function saveasvbx (savefile As String) As String
  153.     frmmain.CMDialog1.Filename = curmodfile
  154.     ChDir dftdir
  155.     frmmain.CMDialog1.Filter = "Autoload (*.AVB)|*.AVB|Text (*.txt)|*.txt|All files (*.*)|*.*"
  156.     frmmain.CMDialog1.DefaultExt = "AVB"
  157. On Error GoTo mycancel
  158.     frmmain.CMDialog1.Action = 2
  159.     saveasvbx = frmmain.CMDialog1.Filename
  160. Exit Function
  161.  
  162. mycancel:
  163. If Err = 32755 Then
  164.     saveasvbx = "cancel"
  165.     Exit Function
  166. End If
  167. End Function
  168.  
  169.